home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / vesa_tsr.zip / SAMPLES / VESABOX.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-11  |  16KB  |  574 lines
  1. {-----------------------------------------------------------------------}
  2. {VESABOX                        GL:01/05/90    }
  3. {-----------------------------------------------------------------------}
  4. {Program for viewing current screen characteristics in a VESA kind of    }
  5. {manner.                                }
  6. {-----------------------------------------------------------------------}
  7. {The following program is written to loosely conform to the VESA     }
  8. {Super VGA BIOS Extension document VS891001.  The program is intended    }
  9. {as a demonstration and is not intended to be an example of a         }
  10. {high-performance implementations of the VESA standard.            }
  11. {If you find any omissions or errors, please report them to me on the     }
  12. {Everex Systems BBS at (415) 683-2984.                    }
  13. {                        Gary Lorensen        }
  14. {                        Everex Systems, Inc.    }
  15. {                        48571 Milmont Dr. B3    }
  16. {                        Fremont, CA   94538    }
  17. {-----------------------------------------------------------------------}
  18.  
  19. uses
  20.     dos;
  21.  
  22. {-----------------------------------------------------------------------}
  23.  
  24. const
  25.   ULCorner = #218;  {Line drawing characters}
  26.   URCorner = #191;
  27.   LLCorner = #192;
  28.   LRCorner = #217;
  29.   VertBar  = #179;
  30.   HorzBar  = #196;
  31.  
  32.   rSequAddr = $3C4;
  33.  
  34. {-----------------------------------------------------------------------}
  35.  
  36. type
  37.     s80 = string[80];
  38.     s8  = string[8];
  39.  
  40.     CharString = array [$00..$03] of char;
  41.  
  42.     ModeListType = array [$00..$00] of word;
  43.  
  44.     PageFuncPtrType = pointer;
  45.  
  46.     VgaInfoBlockType = record
  47.         VESASignature    : CharString;
  48.     VESAVersion     : word;
  49.     OEMStringPtr    : ^CharString;
  50.     Capabilities    : array [$00..$03] of byte;
  51.     VideoModePtr    : ^ModeListType;
  52.     reserved    : array [$00..$ED] of byte;    {Pad to 256}
  53.     end;
  54.  
  55.     ModeInfoBlockType = record
  56.                      {mandatory information}
  57.     ModeAttributes    : word;
  58.     WinAAttributes    : byte;
  59.     WinBAttributes    : byte;
  60.     WinGranularity    : word;
  61.     WinSize        : word;
  62.     WinASegment    : word;
  63.     WinBSegment    : word;
  64.     WinFuncPtr    : PageFuncPtrType;
  65.     BytesPerScanLine : word;
  66.  
  67.                     {optional information}
  68.     XResolution    : word;
  69.     YResolution    : word;
  70.     XCharSize    : byte;
  71.     YCharSize    : byte;
  72.     NumberOfPlanes    : byte;
  73.     BitsPerPixel    : byte;
  74.     NumberOfBanks    : byte;
  75.     MemoryModel    : byte;
  76.     BankSize    : byte;
  77.     reserved    : array [$00..$E2] of byte;    {Pad to 256}
  78.     end;
  79.  
  80.     ScrCharType = record
  81.         ch   : char;
  82.     attr : byte;
  83.     end;
  84.  
  85.     ScrTextPtrType = ^ScrTextType;
  86.     ScrTextType = array [$0000..$0000] of ScrCharType;
  87.     ScrGrfxPtrType = ^ScrGrfxType;
  88.     ScrGrfxType = array [$0000..$0000] of byte;
  89.  
  90. {-----------------------------------------------------------------------}
  91. {-----------------------------------------------------------------------}
  92.  
  93. var
  94.     reg : Registers;
  95.     VesaVgaInfo : VgaInfoBlockType;
  96.     VesaModeInfo : ModeInfoBlockType;
  97.     i : word;
  98.     VesaMode    : word;
  99.     error : boolean;
  100.     textscr : ScrTextPtrType;
  101.     grfxscr : ScrGrfxPtrType;
  102.     pixofs  : longint;
  103.     pixbank : byte;
  104.     prevbank : byte;
  105.     x,y     : word;
  106.  
  107. {-----------------------------------------------------------------------}
  108. {-----------------------------------------------------------------------}
  109.  
  110. function decval(ch : char) : byte;
  111.  
  112. begin
  113.     decval := 0;
  114.     if ((ch>='0') and (ch<='9')) then
  115.         decval := ord(ch)-ord('0');
  116.     if ((ch>='A') and (ch<='F')) then
  117.         decval := ord(ch)-ord('A')+$0A;
  118.     if ((ch>='a') and (ch<='f')) then
  119.         decval := ord(ch)-ord('a')+$0A;
  120. end;
  121.  
  122. function hex2dec(s : s80) : word;
  123.  
  124. var
  125.     i     : byte;
  126.     tmp   : word;
  127.     place : word;
  128.     error : boolean;
  129.  
  130. begin
  131.     i := ord(s[0]);
  132.     error := false;
  133.     place := 1;
  134.     tmp := 0;
  135.     while (i>0) and not(error) do begin
  136.         error := not(((s[i]>='0')and(s[i]<='9')) 
  137.         or ((s[i]>='a')and(s[i]<='f'))
  138.         or ((s[i]>='A')and(s[i]<='F')));
  139.         tmp := tmp+place*decval(s[i]);
  140.     i:=i-1;
  141.     place := place*$10;
  142.     end;
  143.     if (error) then
  144.         hex2dec := $FFFF
  145.     else
  146.         hex2dec := tmp;
  147. end;
  148.  
  149. {-----------------------------------------------------------------------}
  150.  
  151. function hexval(x : byte) : char;
  152.  
  153. begin
  154.     hexval := '0';
  155.     if ((x>=0) and (x<=9)) then
  156.         hexval := chr(x+ord('0'));
  157.     if ((x>=10) and (x<=15)) then
  158.         hexval := chr(x-10+ord('A'));
  159. end;
  160.  
  161. function dec2hex(x : word) : s8;
  162.  
  163. var
  164.     tmp   : s8;
  165.     place : word;
  166.  
  167. begin
  168. {    tmp   := '0';}
  169.     tmp := ' ';
  170.     if (x>=$100) then
  171.         place := $1000
  172.     else
  173.         place := $10;
  174.  
  175.     repeat
  176.         tmp := tmp+hexval(x div place);
  177.     x := x mod place;
  178.     place := place div $10;
  179.     until (place=$0000);
  180.  
  181.     dec2hex := tmp+'h';
  182. end;
  183.  
  184.  
  185. function hex(x : word) : s8;
  186.  
  187. var
  188.     tmp   : s8;
  189.     place : word;
  190.  
  191. begin
  192.     tmp := '0';
  193.     if (x>=$100) then
  194.         place := $1000
  195.     else
  196.         place := $10;
  197.  
  198.     repeat
  199.         tmp := tmp+hexval(x div place);
  200.     x := x mod place;
  201.     place := place div $10;
  202.     until (place=$0000);
  203.  
  204.     hex := tmp+'h';
  205. end;
  206.  
  207. function addrhex(x : word) : s8;
  208.  
  209. var
  210.     tmp   : s8;
  211.     place : word;
  212.  
  213. begin
  214.     tmp := '';
  215.     place := $1000;
  216.  
  217.     repeat
  218.         tmp := tmp+hexval(x div place);
  219.     x := x mod place;
  220.     place := place div $10;
  221.     until (place=$0000);
  222.  
  223.     addrhex := tmp;
  224. end;
  225.  
  226. {-----------------------------------------------------------------------}
  227.  
  228. procedure SetVesaBank(win  : byte;
  229.                       bank : byte);
  230.  
  231. var
  232.     reg : Registers;
  233.  
  234. begin
  235.     reg.AX := $4F05;
  236.     reg.BH := $00;
  237.     reg.BL := win;
  238.     reg.DX := bank;
  239.     intr($10,reg);
  240. end;
  241.  
  242. {-----------------------------------------------------------------------}
  243.  
  244. procedure GetVesaBank(win  : byte;
  245.                       var bank : byte);
  246.  
  247. var
  248.     reg : Registers;
  249.  
  250. begin
  251.     reg.AX := $4F05;
  252.     reg.BH := $01;
  253.     reg.BL := win;
  254.     intr($10,reg);
  255.     bank := reg.DX;
  256. end;
  257.  
  258. {-----------------------------------------------------------------------}
  259. {-----------------------------------------------------------------------}
  260.  
  261. begin
  262.     error := false;
  263.  
  264.     writeln('VESA BIOS Extensions BOX program');
  265.     writeln('1990 Everex Systems, Inc.');
  266.  
  267.     reg.AX := $4F00;
  268.     reg.ES := Seg(VesaVgaInfo);
  269.     reg.DI := Ofs(VesaVgaInfo);
  270.     intr($10,reg);
  271.  
  272.     if (reg.AL<>$4F) then begin
  273.         writeln('ERROR: VESA Function 00h: Return Super VGA Information not supported.');
  274.     error := true;
  275.     end;
  276.  
  277.     if (reg.AH<>$00) then begin
  278.         writeln('ERROR: VESA Function 00h: Return Super VGA Information failed.');
  279.     error := true;
  280.     end;
  281.  
  282.     if not(error) then begin
  283.  
  284.         reg.AX := $4F03;
  285.     intr($10,reg);
  286.  
  287.     if (reg.al<>$4F) then
  288.         error := true;
  289.  
  290.         if (reg.AH<>$00) then
  291.         error := true;
  292.  
  293.     if not(error) then begin
  294.         VesaMode := reg.BX;
  295.  
  296.         reg.AX := $4F01;
  297.         reg.CX := VesaMode;
  298.         reg.ES := Seg(VesaModeInfo);
  299.         reg.DI := Ofs(VesaModeInfo);
  300.             intr($10,reg);
  301.  
  302.             if (reg.AL<>$4F) then
  303.             error := true;
  304.  
  305.         if (reg.AH<>$00) then
  306.             error := true
  307.  
  308.         else if ((error) or ((VesaModeInfo.ModeAttributes and $02)=$00)) then
  309.             error := true
  310.  
  311.         else begin
  312.             write(VesaModeInfo.XResolution:4,'x',VesaModeInfo.YResolution:3);
  313.             if ((VesaModeInfo.ModeAttributes and $10)=$10) then
  314.                 write('x',VesaModeInfo.NumberOfPlanes:1)
  315.             else
  316.                 write('  ');
  317.             write(' ',VesaModeInfo.BitsPerPixel:1,'bpp');
  318.             write(' ',VesaModeInfo.XCharSize:2,'x',VesaModeInfo.YCharSize:2);
  319.             write(' ');
  320.  
  321.             if ((VesaModeInfo.ModeAttributes and $08)=$08) then
  322.                 write('Color ')
  323.             else
  324.                 write('Mono  ');
  325.  
  326.             if (VesaModeInfo.BankSize>0) then 
  327.                 write(' ',VesaModeInfo.BankSize:2,'Kx',VesaModeInfo.NumberOfBanks:1);
  328.  
  329.             if ((VesaModeInfo.WinAAttributes and $01)=$01) then begin
  330.                 write('A:',addrhex(VesaModeInfo.WinASegment),' ');
  331.             if ((VesaModeInfo.WinAAttributes and $02)=$02) then
  332.                 write('R')
  333.             else 
  334.                 write(' ');
  335.             if ((VesaModeInfo.WinAAttributes and $04)=$04) then
  336.